home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / MATH.SWG / 0047_BASE of a Number.pas < prev    next >
Pascal/Delphi Source File  |  1993-11-02  |  5KB  |  170 lines
  1. { Three ways to find the BASE of a number }
  2.  
  3.  
  4. function base2l(strin: string; base: byte): longint;
  5.  
  6. { converts a string containing a "number" in another base into a decimal
  7.   longint }
  8.  
  9. var cnter, len: byte;
  10.     dummylint: longint;
  11.     seendigit, negatize: boolean;
  12.     begalpha, endalpha, thschr: char;
  13. begin
  14.   dummylint := 0;
  15.   begalpha := char(65);
  16.   endalpha := char(64 + base - 10);
  17.   negatize := false;
  18.   seendigit := false;
  19.   len := length(strin);
  20.   cnter := 1;
  21.  
  22.   { the following loop processes each character }
  23.  
  24.   while cnter <= len do begin
  25.     thschr := upcase(strin[cnter]);
  26.     case thschr of
  27.       '-': if seendigit then cnter := len else negatize := true;
  28.  
  29.            { if we haven't seen any "digits" yet, it'll be a negative
  30.              number; otherwise the hyphen is an extraneous character so
  31.              we're done processing the string }
  32.  
  33.       '0' .. '9': if byte(thschr) - 48 < base then begin
  34.                     dummylint := base*dummylint + byte(thschr) - 48;
  35.                     seendigit := true;
  36.                     end
  37.                    else cnter := len;
  38.  
  39.            { 0-9: if the base supports the digit, use it; otherwise,
  40.              it's an extraneous character and we're done }
  41.  
  42.       ' ': if seendigit then cnter := len;
  43.  
  44.            { space: if we've already encountered some digits, we're done }
  45.  
  46.       else begin
  47.  
  48.            { all other characters }
  49.  
  50.         if (thschr >= begalpha) and (thschr <= endalpha) then
  51.  
  52.           { an acceptable character for this base }
  53.  
  54.           dummylint := base*dummylint + byte(thschr) - 65 + 10
  55.          else
  56.  
  57.           { not acceptabe: we're done }
  58.  
  59.           cnter := len;
  60.         end;
  61.       end;
  62.     cnter := cnter + 1;
  63.     end;
  64.   if negatize then dummylint := -dummylint;
  65.   base2l := dummylint;
  66.   end;
  67.  
  68. {Another way:}
  69.  
  70. function l2base(numin: longint; base, numplaces: byte; leadzero: boolean): string;
  71.  
  72. { Converts a longint into a string representing the number in another base.
  73.   Numin = the longint; base = base; numplaces is how many characters the answer
  74.   should go in; leadzero indicates whether to put leading zeros. }
  75.  
  76. var tmpstr: string;
  77.     remainder, cnter, len: byte;
  78.     negatize: boolean;
  79. begin
  80.   negatize := (numin < 0);
  81.   if negatize then numin := abs(numin);
  82.  
  83.   { assign number of places in string }
  84.  
  85.   tmpstr[0] := char(numplaces);
  86.   len := numplaces;
  87.  
  88.   { now fill those places from right to left }
  89.  
  90.   while numplaces > 0 do begin
  91.     remainder := numin mod base;
  92.     if remainder > 9 then
  93.       tmpstr[numplaces] := char(remainder + 64 - 9)
  94.      else
  95.       tmpstr[numplaces] := char(remainder + 48);
  96.     numin := numin div base;
  97.     numplaces := numplaces - 1;
  98.     end;
  99.  
  100.   { not enough room assigned: fill with asterisks }
  101.  
  102.   if (numin <> 0) or (negatize and (tmpstr[1] <> '0')) then
  103.      for numplaces := 1 to byte(tmpstr[0]) do tmpstr[numplaces] := '*';
  104.  
  105.   { put in minus sign }
  106.  
  107.   if leadzero then begin
  108.     if negatize and (tmpstr[1] = '0') then tmpstr[1] := '-'
  109.     end
  110.    else begin
  111.     cnter := 1;
  112.     while (cnter < len) and (tmpstr[cnter] = '0') do begin
  113.       tmpstr[cnter] := ' ';
  114.       cnter := cnter + 1;
  115.       end;
  116.     if negatize and (cnter > 1) then tmpstr[cnter - 1] := '-';
  117.     end;
  118.   l2base := tmpstr;
  119.   end;
  120.  
  121. { Yet another way }
  122.  
  123. Program ConvertBase;
  124.  
  125. Procedure UNTESTEDConvertBase(BaseN:Byte; BaseNNumber:String;
  126.                                   BaseZ:Byte; var BaseZNumber:String);
  127.  
  128. var
  129.   I: Integer;
  130.   Number,Remainder: LongInt;
  131.  
  132. begin
  133.  Number := 0;
  134.  for I := 1 to Length (BaseNNumber) do
  135.   case BaseNNumber[I] of
  136.     '0'..'9': Number := Number * BaseN + Ord (BasenNumber[I]) - Ord ('0');
  137.     'A'..'Z': Number := Number * BaseN + Ord (BasenNumber[I]) -
  138.       Ord ('A') + 10;
  139.     'a'..'z': Number := Number * BaseN + Ord (BasenNumber[I]) -
  140.       Ord ('a') + 10;
  141.     end; BaseZNumber := ''; while Number > 0 do
  142.   begin
  143.   Remainder := Number mod BaseZ;
  144.   Number := Number div BaseZ;
  145.   case Remainder of
  146.     0..9: BaseZNumber := Char (Remainder + Ord ('0')) + BaseZNumber;
  147.     10..36: BaseZNumber := Char (Remainder - 10 + Ord ('A')) + BaseZNumber;
  148.     end;
  149.  
  150. end; end;
  151.  
  152.  
  153. var BaseN,BaseZ:Byte;
  154.     BaseNNumber,
  155.     BaseZNumber:String;
  156.  
  157. Begin
  158.  
  159.  Write(' BASE N  > ');
  160.  Readln(BaseN);
  161.  Write(' NUMBER N> ');
  162.  Readln(BaseNNumber);
  163.  Write(' BASE Z  > ');
  164.  Readln(BaseZ);
  165.  Write(' NUMBER Z> ');
  166.  UntestedConvertBase(BaseN,BaseNNumber,BaseZ,BaseZNumber);
  167.  Writeln(BaseZNumber);
  168.  Readln;
  169. end.
  170.